home *** CD-ROM | disk | FTP | other *** search
/ Programmer Plus 2007 / Programmer-Plus-2007.iso / Programming / Borland Plateform / TURBO PASCAL 1.5 for WIN / PAINT.PAK / PAINTDEF.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-06-08  |  8.2 KB  |  300 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal for Windows: Paint Demo         }
  4. {   paintdef unit                                }
  5. {   Copyright (c) 1992 by Borland International  }
  6. {                                                }
  7. {************************************************}
  8.  
  9. unit PaintDef;
  10.  
  11. { This unit supplies the basic definitions used by all modules of the
  12.   paint program, as well as a few utility routines dealing mainly
  13.   with common dialogs.
  14. }
  15.  
  16. interface
  17.  
  18. uses ResDef, StdDlgs, WinTypes, WinProcs, WObjects;
  19.  
  20. var 
  21.   DashedPen: HPen;
  22.  
  23. type
  24.  
  25.   PPaintTool = ^TPaintTool;
  26.  
  27.   { The state object is used for communication among modules of the
  28.     paint program. It records the state of drawing, i.e., what has
  29.     been drawn, what colors, pen, brush, etc. are selected, what the
  30.     current screen selection is, etc. Only one state object should
  31.     exist for each paint screen.
  32.   }
  33.  
  34.   PState = ^TState;
  35.   TState = record
  36.     PaintTool: PPaintTool;      { Tool currently in use }
  37.     MemDC: HDC;            { Display contex with the offscreen Bitmap }
  38.     Offset: TPoint;        { Offset of Bitmap origin relative to screen }
  39.     BitmapSize: TPoint;            { Size of current bitmap }
  40.     IsDirtyBitmap: Boolean;      { Records when the Bitmap has been modified }
  41.     Selection: TRect;           { Coordinates of current screen selection }
  42.     SelectionBM: HBitmap;       { Contents of current screen selection }
  43.     PenSize: Integer;           { Current line width selected }
  44.     PenColor: TColorRef;        { Current line color selected }
  45.     BrushColor: TColorRef;      { Current fill color selected }
  46.   end;
  47.  
  48.  
  49.   { Paint tools are the basic entities that cause painting to be done
  50.     in the paint program. PaintTool defines the interface required by
  51.     all PaintTools, but no implementation (save initialization).
  52.   }
  53.  
  54.   TPaintTool = object(TObject)
  55.     Icon: HIcon;                { Icon associated with tool }
  56.     Cursor: HCursor;            { Cursor to be displayed when tool is
  57.                                   in use }
  58.     State: PState;              { Current state of drawing }
  59.     Window: HWnd;               { Window tool is operating on }
  60.     DC: HDC;                    { Screen display context to be operated on }
  61.  
  62.     { Creation and activation }
  63.     constructor Init(AState: PState; IconName, CursorName: PChar);
  64.     procedure Select; virtual;
  65.     procedure Deselect; virtual;
  66.  
  67.     { Actions initiated by mouse action }
  68.     procedure MouseDown(AWindow: HWnd; X, Y: Integer;
  69.       AState: PState); virtual;
  70.     procedure MouseMove(X, Y: Integer); virtual;
  71.     procedure MouseUp; virtual;
  72.     procedure DrawBegin(X, Y: Integer); virtual;
  73.     procedure DrawTo(X, Y: Integer); virtual;
  74.     procedure DrawEnd; virtual;
  75.  
  76.     { Utility routines used by mouse actions }
  77.     procedure PickUpSelection(aDC: HDC; Left, Top, aWidth, aHeight: Integer);
  78.       virtual;
  79.     procedure ReleaseSelection; virtual;
  80.     procedure DropSelection; virtual;
  81.  
  82.     { Actions initiated by keyboard }
  83.     procedure Char(Key, Count, lParamHi: Word); virtual;
  84.   end;
  85.  
  86. { Utility routines }
  87.  
  88. { Dialog Interactions }
  89.  
  90. { Display a message in a dialog with certain standard buttons.
  91. }
  92. function Ask(Quest: PChar): Boolean;            { Yes/No }
  93. function AskCancel(Quest: PChar): Integer;      { Yes/No/Cancel }
  94. function Confirm(Msg: PChar): Boolean;          { Ok/Cancel }
  95. procedure Tell(Msg: PChar);                     { Ok }
  96.  
  97. { 
  98.   Display standard file dialogs. Path may contain a mask (e.g.,
  99.   '*.pas') and contains full path name on return. Function return
  100.   value is True if file was selected, False on Cancel. 
  101. }
  102. function FileOpenDialog(Path: PChar): Boolean;  { File open }
  103. function FileSaveDialog(Path: PChar): Boolean;  { Filename selection }
  104.  
  105. { Other }
  106. function CreateCompatibleDCW(HWindow: Hwnd): HDC;
  107.  
  108. implementation
  109.  
  110. { TPaintTool }
  111.  
  112. { Default initialization of a Paint Tool.
  113. }
  114. constructor TPaintTool.Init(AState: PState; IconName, CursorName: PChar);
  115. begin
  116.   TObject.Init;
  117.   State := AState;
  118.   Icon := LoadIcon(HInstance, IconName);
  119.   Cursor := LoadCursor(HInstance, CursorName);
  120. end;
  121.  
  122. { Set up the paint tool to be the currently used tool.
  123. }
  124. procedure TPaintTool.Select;
  125. begin
  126.   State^.PaintTool := @Self;
  127. end;
  128.  
  129. {
  130.   Prepare the paint tool to no longer be the currently used tool.
  131. }
  132. procedure TPaintTool.Deselect;
  133. begin
  134. end;
  135.  
  136. { Actions initiated by mouse actions. }
  137.  
  138. { Action to be taken when the mouse button is pressed down (and the
  139.   tool is the currently used tool).
  140. }
  141. procedure TPaintTool.MouseDown(AWindow: HWnd; X, Y: Integer;
  142.   AState: PState);
  143. begin
  144. end;
  145.  
  146. { Action to be taken when the mouse button is down and the mouse is moved.
  147. }
  148. procedure TPaintTool.MouseMove(X, Y: Integer);
  149. begin
  150. end;
  151.  
  152. { Action to be taken when the mouse button is released.
  153. }
  154. procedure TPaintTool.MouseUp;
  155. begin
  156. end;
  157.  
  158. { Prepare the tool to begin drawing. Used by tools whose actions are
  159.   in response to mouse clicks. Their drawing actions are divided into
  160.   three phases: 1) DrawBegin on mouse down, 2) DrawTo when the mouse
  161.   is moved, and 3) DrawEnd when the mouse is released.
  162. }
  163. procedure TPaintTool.DrawBegin(X, Y: Integer);
  164. begin
  165. end;
  166.  
  167. { Perform the tool drawing action.
  168. }
  169. procedure TPaintTool.DrawTo(X, Y: Integer);
  170. begin
  171. end;
  172.  
  173. { Prepare the tool to stop drawing.
  174. }
  175. procedure TPaintTool.DrawEnd;
  176. begin
  177. end;
  178.  
  179.  
  180. { Utility routines used by mouse action routines.
  181.  
  182. { Prepare the rectangle selected on the screen to be treated as
  183.   a distinct entity. E.g., for dragging or cutting.
  184. }
  185. procedure TPaintTool.PickUpSelection(aDC: HDC; Left, Top, 
  186.                                                aWidth, aHeight: Integer);
  187. begin
  188. end;
  189.  
  190. { Release the current selection without modifying the current Bitmap.
  191. }
  192. procedure TPaintTool.ReleaseSelection;
  193. begin
  194. end;
  195.  
  196. { Copy the current selection onto the current Bitmap and release the
  197.   selection. 
  198. }
  199. procedure TPaintTool.DropSelection;
  200. begin
  201. end;
  202.  
  203. { Action initiated by the keyboard.
  204.  
  205. { Action to be taken when a non-system key is pressed. That is, not an
  206.   "alt" or other specially interpreted key-stroke.
  207. }
  208. procedure TPaintTool.Char(Key, Count, lParamHi: Word);
  209. begin
  210. end;
  211.  
  212. { Utility routines }
  213.  
  214. { Display a message in a dialog box with certain common buttons.
  215. }
  216. { Yes/No }
  217. function Ask(Quest: PChar): Boolean;
  218. begin
  219.   Ask := MessageBox(0, Quest, '', mb_YesNo) = id_Yes;
  220. end;
  221.  
  222. { Yes/No/Cancel }
  223. function AskCancel(Quest: PChar): Integer;
  224. begin
  225.   AskCancel := MessageBox(0, Quest, '', mb_YesNoCancel);
  226. end;
  227.  
  228. { Ok/Cancel }
  229. function Confirm(Msg: PChar): Boolean;
  230. begin
  231.   Confirm := MessageBox(0, Msg, '', mb_OkCancel) = id_OK;
  232. end;
  233.  
  234. { Ok }
  235. procedure Tell(Msg: PChar);
  236. begin
  237.   MessageBox(0, Msg, '', mb_Ok);
  238. end;
  239.  
  240.  
  241. { File Dialogs }
  242.  
  243. { Display a standard file dialog. Path will be filled in with the
  244.   selected filename (full path). Which is a "sd_" constant specifying
  245.   which file dialog to display.
  246. }
  247. function FileDialog(var Path: PChar; Which: PChar): Boolean;
  248. begin
  249.   FileDialog := 
  250.   Application^.ExecDialog(new(PFileDialog, Init(Application^.MainWindow,
  251.     Which, Path))) = id_OK;
  252. end;
  253.  
  254. { Standard file open. (Select an existing file.) }
  255. function FileOpenDialog(Path: PChar): Boolean;
  256. begin
  257.   FileOpenDialog := FileDialog(Path, PChar(sd_FileOpen));
  258. end;
  259.  
  260. { Standard file save. (Select a new or existing file.) }
  261. function FileSaveDialog(Path: PChar): Boolean;
  262. begin
  263.   FileSaveDialog := FileDialog(Path, PChar(sd_FileSave));
  264. end;
  265.  
  266. { Other }
  267.  
  268. { Given a window, return a drawing context that is compatible with
  269.   that window.
  270. }
  271. function CreateCompatibleDCW(HWindow: Hwnd): HDC;
  272. var
  273.   DC: HDC;
  274. begin
  275.   DC := GetDC(HWindow);
  276.   CreateCompatibleDCW :=  CreateCompatibleDC(DC);
  277.   ReleaseDC(HWindow, DC);
  278. end;
  279.  
  280. { Deal with deinitialization of unit. }
  281. var
  282.   SaveExit: Pointer;
  283.  
  284. procedure PaintDefExit;
  285. far;
  286. begin
  287.   DeleteObject(DashedPen);
  288.   ExitProc := SaveExit;
  289. end;
  290.  
  291. { initialization }
  292. begin
  293.   { A pen that draws a dashed line. }
  294.   DashedPen := CreatePen(ps_Dot, 1, $000000);
  295.  
  296.   { Set up unit de-initialization }
  297.   SaveExit := ExitProc;
  298.   ExitProc := @PaintDefExit;
  299. end.
  300.